home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar / 1998 / Jul / di9807jp / SFTPCLIENT / CDataThrd.pas < prev    next >
Pascal/Delphi Source File  |  1998-02-20  |  4KB  |  171 lines
  1. (*
  2.  Data Thread unit developed for Delphi Informant article by John Penman, January 1998
  3.  SFTP Client data thread
  4. *)
  5. unit CDataThrd;
  6. interface
  7.  
  8. uses
  9.   Classes, Windows, Winsock2;
  10.  
  11. type
  12.   TDataThrd = class(TThread)
  13.   private
  14.     { Private declarations }
  15.   protected
  16.     sktListenData,
  17.     sktData : TSocket;
  18.     DataAddr : TSockAddrIn;
  19.     Msg,
  20.     NewFileName : String;
  21.     procedure Execute; override;
  22.     procedure OnDataThrdDone(Sender : TObject);
  23.     procedure GetFile;
  24.     procedure Update;
  25.   public
  26.     constructor Create(PortNo : Integer; FileName : String);
  27.   end;
  28.  
  29. var
  30.  thrdData : TDataThrd;
  31.  
  32. implementation
  33.  
  34. uses
  35.  Dialogs, Main, CMsgThrd, SysUtils;
  36.  
  37.  { TDataThrd }
  38.  
  39. constructor TDataThrd.Create(PortNo : Integer; FileName : String);
  40. var
  41.  Res : Integer;
  42. begin
  43. // create thread in suspended state, so we can set important variables ...
  44.  inherited create(TRUE);
  45.  FreeOnTerminate := TRUE;
  46.  OnTerminate := OnDataThrdDone;
  47.  sktListenData := WSASocket(AF_INET,SOCK_STREAM, IPPROTO_TCP, NIL, 0, 0);
  48.  if sktListenData = INVALID_SOCKET then
  49.  begin
  50.   Msg := Concat('Failed to create listening socket! Error ',IntToStr(WSAGetLastError));
  51.   Synchronize(Update);
  52.   State := stError;
  53.   Exit;
  54.  end;
  55.  with DataAddr do
  56.  begin
  57.   sin_port        := htons(PortNo);
  58.   sin_family      := AF_INET;
  59.   sin_addr.s_addr := INADDR_ANY;
  60.  end;
  61.  Res := bind(sktListenData, DataAddr, SizeOf(DataAddr));
  62.  if Res = SOCKET_ERROR then
  63.  begin
  64.   Msg := Concat('Failed to create listening socket! Error ',IntToStr(WSAGetLastError));
  65.   Synchronize(Update);
  66.   State := stError;
  67.   closesocket(sktListenData);
  68.   Exit;
  69.  end;
  70.  NewFileName := FileName;
  71. // Start the data thread
  72.  Resume;
  73. end;
  74.  
  75. // Execute the data transfer in the background ...
  76.  
  77. procedure TDataThrd.Execute;
  78. begin
  79.  GetFile;
  80. end;
  81.  
  82. // Retrieve the file ...
  83.  
  84. procedure TDataThrd.GetFile;
  85. var
  86.  Buffers                    : array[0..MAXGETHOSTSTRUCT-1] of char;
  87.  Done                       : Boolean;
  88.  Data                       : PWSABUF;
  89.  Flags,
  90.  NoBytesRecv,
  91.  Res,
  92.  Size                       : Integer;
  93.  FileStream                 : TFileStream;
  94. begin
  95.  Res := listen(sktListenData,1);
  96.  if Res = SOCKET_ERROR then
  97.  begin
  98.   Msg := Concat('Call to listen failed. Error ',IntToStr(WSAGetLastError));
  99.   Synchronize(Update);
  100.   closesocket(sktListenData);
  101.   State := stError;
  102.   Exit;
  103.  end;
  104.  Size          := SizeOf(DataAddr);
  105.  sktData       := WSASocket(AF_INET,SOCK_STREAM, IPPROTO_TCP, NIL, 0, 0);
  106.  sktData       := accept(sktListenData, DataAddr, Size);
  107.  if sktData = INVALID_SOCKET then
  108.  begin
  109.   Msg := Concat('Call to accept failed. Error ',IntToStr(WSAGetLastError));
  110.   Synchronize(Update);
  111.   State := stError;
  112.   closesocket(sktListenData);
  113.   closesocket(sktData);
  114.   Exit;
  115.  end;
  116.  closesocket(sktListenData);
  117. // Set the Data buffer and FileStream to avoid warning messages from the compiler
  118.  Data          := NIL;
  119.  FileStream    := NIL;
  120.  try
  121.   Data         := AllocMem(SizeOf(Buffers));
  122.   Data.buf     := Buffers;
  123.   Data.len     := SizeOf(Buffers);
  124.   Flags := 0;
  125. // Create a new file for writing
  126.   try
  127.    FileStream := TFileStream.Create('C:\'+NewFileName, fmOpenWrite);
  128.    Done := FALSE;
  129.    repeat
  130.     Res := WSARecv(sktData, Data, 1, @NoBytesRecv, @Flags, NIL, NIL);
  131.     if Res = SOCKET_ERROR then
  132.     begin
  133.      FileStream.Free;
  134.      Msg := Concat('Call to WSARecv failed. Error ',IntToStr(WSAGetLastError));
  135.      Synchronize(Update);
  136.      State := stError;
  137.      closesocket(sktData);
  138.      Exit;
  139.     end;
  140.     if NoBytesRecv = 0 then
  141.      Done := TRUE
  142.     else
  143.      FileStream.Write(Data.Buf^, NoBytesRecv);
  144.     until Done;
  145.     closesocket(sktData);
  146.     Msg := Concat('Finished downloading ', NewFileName,' .');
  147.     Synchronize(Update);
  148.    finally
  149.     FileStream.Free;
  150.    end;
  151.  finally
  152.   FreeMem(Data, SizeOf(Buffers)-1);
  153.  end;
  154. end;
  155.  
  156. procedure TDataThrd.Update;
  157. begin
  158.  frmMain.memStatusMsg.Lines.Add(Msg);
  159. end;
  160.  
  161. procedure TDataThrd.OnDataThrdDone(Sender : TObject);
  162. begin
  163.  Terminate;
  164.  Msg := 'Finished!';
  165.  Synchronize(Update);
  166.  frmMain.bbtnGetFile.Enabled := TRUE;
  167. end;
  168.  
  169.  
  170. end.
  171.